perm filename DDJOB.SAI[DD,BGB]1 blob
sn#001296 filedate 1972-04-30 generic text, type T, neo UTF8
00100 BEGIN "DDJOB"
00200 REQUIRE "ABBREV[SYS,BGB]" SOURCE_FILE;
00300 REQUIRE "DRUMER[SYS,BGB]" SOURCE_FILE;
00400 REQUIRE "SAITRG[SYS,BGB]" SOURCE_FILE;
00500 α ARRAY ALLOCATION;
00600 EXTERNAL PROCEDURE LRMAK (INTEGER LO,HI,ONE);
00700 EXTERNAL INTEGER ARYEL;
00800 DEFINE GETARY(ARRY,SIZE) =
00900 "BEGIN LRMAK(1,SIZE,1); QUICK_CODE MOVEM 1,ARRY;END;END";
01000 DEFINE RELARY(ARRY) =
01100 "QUICK_CODE PUSH 15,ARRY;PUSHJ 15,ARYEL;END";
01200
01300 INTEGER TVPTR;
01400 DEFINE MAIL="'710000000000";
01500 α THE LETTER; SAFE SHORT INTEGER ARRAY LETTER[0:31];
01600 DEFINE
01700 HISJOB = "LETTER[0]",
01800 FILENAME="LETTER[1]",EXTENSION="LETTER[2]",PPNAME="LETTER[3]",
01900 LEVWRD = "LETTER[4]",
02000 JADDR = "LETTER[5]",
02100 LEVCHN = "LETTER[6]",
02200 SX="LETTER[7]",SY="LETTER[8]",SDX="LETTER[9]",SDY="LETTER[10]",
02300 OX="LETTER[11]",OY="LETTER[12]",MAGPOW="LETTER[13]",
02400 FRAME# = "LETTER[14]",
02500 SEGNAME = "LETTER[15]",
02600 ILX="LETTER[16]",ILY="LETTER[17]",ILDX="LETTER[18]",ILDY="LETTER[19]",
02700 DR="LETTER[20]",DC="LETTER[21]",DM="LETTER[22]",DN="LETTER[23]",
02800 VCNT = "LETTER[24]",
02900 ACNT = "LETTER[25]",
03000 COMMAND = "LETTER[31]";
03100 α COMMAND 1 DPYDD;
03200 α COMMAND 2 SHOWDD;
03300 α COMMAND 3 DRUMDD;
03400 α COMMAND 4 TVSEG;
03500
03600 α PHYSICAL WINDOW FRAMES;
03700 DEFINE TVM="216", TVN="288";
03800 DEFINE DDR="0", DDC="0";
03900 DEFINE DDM="480", DDN="512";
04000 DEFINE DDR2="479",DDC2="511";
00100 α THE LOGICAL WINDOW;
00200 REAL LX,LY,LDX,LDY;
00300 α CHANNEL MAP;
00400 PRELOAD_WITH 0,'37,'35,'34,'33,'32,'36,'30;
00500 INTEGER ARRAY DDCHAN[0:16];
00600 α RC SOURCE WINDOW;
00700 SHORT INTEGER SR,SC,SM,SN;
00800 α DESTINATION WINDOW;
00900 SHORT INTEGER DR2,DC2;
01000 INTEGER MAGNIF;
01100 α BUFFERS AND BUFFER DIMENSIONS;
01200 BEGIN
01300 SAFE INTEGER ARRAY TVBUF,BIBUF,DDBUF[1:2];
01400 INTEGER BIWWID,BISIZE,DDWWID,FLDSIZ,DDSIZE;
00100 PROCEDURE PLOWIN;
00200 BEGIN "PLOWIN"
00300 INTEGER ROW,MROWS,NCOLS;
00400 INTEGER DELTA2,DELTA3;
00500 α DDBUF DESTINATION WINDOW;
00600 ROW ← 0;
00700 α BIBUF SOURCE WINDOW;
00800 DELTA2 ← FLDSIZ - BIWWID;
00900 DELTA3 ← 4*FLDSIZ - DDWWID;
01000 START_CODE "LOOP"
01100 LABEL L1,L2,INPTR,OUTPTR;
01200 DEFINE CCNT="0",TMP="1",RCNT="2";
01300 INTEGER TMP16,TMP17;
01400 α INIT ADDRESSES IN INNER LOOP;
01500 MOVE BIBUF;
01600 HRRM INPTR;
01700 MOVE DDBUF;
01800 ADDI 2;
01900 HRRM OUTPTR;
00100 α SAVE SAIL;
00200 MOVEM '16,TMP16;
00300 MOVEM '17,TMP17;
00400 α PICKUP THE INNER LOOP;
00500 HRLZI L1;
00600 HRRI 3;
00700 BLT '16;
00800 α INIT THE INNER LOOP;
00900 MOVE RCNT, DM;
01000 HRR 3, BIWWID;
01100 HRR '12, DELTA2;
01200 HRR '14, DELTA3;
01300 α ENTER THE INNER LOOP;
01400 JRST 3;
01500 L1: MOVEI CCNT,;
01600 INPTR: MOVE TMP,;
01700 OUTPTR: IORM TMP,;
01800 AOS 4;
01900 AOS 5;
02000 SOJG CCNT, 4;
02100 AOS TMP, ROW;
02200 ADDI 5, 2160; α FLDSIZ - BIWWID;
02300 TRNN TMP, 3;
02400 SUBI 5, 8622; α 4*FLDSIZ - DDWWID;
02500 SOJG RCNT, 3;
02600 JRST L2;
02700 L2: MOVE '16, TMP16;
02800 MOVE '17, TMP17;
02900 END "LOOP";
03000 END "PLOWIN";
00100 PROCEDURE SHOWDD ;
00200 QUICK_CODE "SHOWDD"
00300 INTEGER T1,T2;
00400 MOVE 11,DDSIZE;
00500 MOVEM 11,T2;
00600 MOVE 11,DDBUF;
00700 HRRZM 11,T1;
00800 '715000000000 3,T1;
00900 END "SHOWDD";
00100 α SETUP THE COLUMN AND CHANNEL SELECT CONTROL WORDS;
00200 PROCEDURE SETCHN (INTEGER CHAN);
00300 BEGIN "SETCHN"
00400 INTEGER CHANWD,DCOL,CHANNEL,I;
00500 CHANNEL ← DDCHAN[CHAN LAND 7];
00600 CHANWD ← '002004003324;
00700 DCOL ← DC%8;
00800 DCOL ← (1 MAX DCOL) MIN 64;
00900 DPB(DCOL, POINT(8,CHANWD,15));
01000 DPB(CHANNEL,POINT(8,CHANWD,23));
01100 FOR I←2 STEP DDWWID UNTIL DDSIZE DO
01200 DDBUF[I]← CHANWD;
01300 DDBUF[DDSIZE]←0;
01400 END "SETCHN";
00100 PROCEDURE GETDD;
00200 BEGIN "GETDD"
00300 INTEGER DDROWS,LINEWD,LINE,DDPTR,FPTR,I,J;
00400 α DIMENSIONS OF THE DD BUFFER;
00500 DDWWID ← (DN + 31)%32 + 2;
00600 DDROWS ← (DM + 3)%4;
00700 FLDSIZ ← DDROWS*DDWWID;
00800 DDROWS ← DDROWS*4;
00900 DDSIZE ← 4*FLDSIZ+2;
01000 α ALLOCATE THE DD BUFFER;
01100 GETARY(DDBUF,DDSIZE);
01200 START_CODE
01300 MOVE 1,DDBUF;
01400 MOVEI 2;
01500 MOVEM (1);
01600 HRL 1,1;
01700 AOS 1;
01800 MOVE 2,DDBUF;
01900 ADD 2,DDSIZE;
02000 SOS 2;
02100 BLT 1,(2);
02200 END;
02300 α SETUP THE EXECUTE AND LINE SELECT CONTROL WORDS;
02400 LINEWD ← '0454;
02500 LINE ← (0 MAX DR) MIN 479;
02600 DDPTR ← 1;
02700 FOR I←1 STEP 4 UNTIL DDROWS DO
02800 BEGIN "ROWS"
02900 FPTR ← DDPTR;
03000 FOR J←0 STEP 1 UNTIL 3 DO
03100 BEGIN "FIELDS"
03200 DPB(LINE ,POINT(4,LINEWD,23));
03300 DPB(LINE%16,POINT(5,LINEWD,15));
03400 DDBUF[FPTR]← LINEWD;
03500 LINE ← LINE+1;
03600 FPTR ← FPTR + FLDSIZ;
03700 END "FIELDS";
03800 DDPTR ← DDPTR + DDWWID;
03900 END "ROWS";
04000 α ...AND THE FIRST AND LAST CONTROL WORDS ARE ALITTLE DIFFERENT;
04100 DDBUF[1] ← DDBUF[1] LOR '116000001454;
04200 DDBUF[DDSIZE-1] ← '000004010334;
04300 DDBUF[DDSIZE] ← 0;
04400 END "GETDD";
00100 PROCEDURE DSKTV (STRING FILE);
00200 BEGIN "DSKTV"
00300 INTEGER ARRAY HEADER[0:9];
00400 INTEGER FLG,CHN;
00500 IF ARRINFO(TVBUF,0) < 10 THEN
00600 GETARY(TVBUF,11664);
00700 IF LENGTH(FILE)=0 THEN RETURN;
00800 CHN ← GETCHAN;
00900 OPEN(CHN,"DSK",8,3,0,0,0,0);
01000 LOOKUP(CHN,FILE&".TMP[DAT,BGB]",FLG);
01100 IF FLG THEN RETURN;
01200 ARRYIN(CHN,HEADER[0],10);
01300 ARRYIN(CHN,TVBUF[1],10368);
01400 RELEASE(CHN);
01500 END "DSKTV";
00100 α REPACK A SIXBIT TV RASTER INTO ONE BIT RASTERS;
00200 PROCEDURE REPACK ;
00300 BEGIN "OUTER REPACK"
00400 SAFE INTEGER ARRAY BI[1:11664];
00500 INTEGER MROWS,NCOLS,TVWW,BTWW,AREA;
00600 MROWS ← 216;
00700 NCOLS ← 288;
00800 TVWW ← NCOLS%6;
00900 BTWW ← NCOLS%32 + (IF NCOLS LAND '37 THEN 1 ELSE 0);
01000 AREA ← MROWS*BTWW;
01100 START_CODE "REPACK"
01200 LABEL L1,L2,L3,L4,DACBUF;
01300 LABEL DAP2,DAP3,DAP4,DAP5,DAP6;
01400 DEFINE BIT="0",BYTE="7",BTPTR="8",BCNT="9";
01500 DEFINE WCNT="10",RCNT="11",TVPTR="12";
01600 α ALITTLE OLD FASHION ADDRESS MODIFICATION;
01700 MOVE AREA; HRRM DAP2;
01800 ADD AREA; HRRM DAP3;
01900 ADD AREA; HRRM DAP4;
02000 ADD AREA; HRRM DAP5;
02100 ADD AREA; HRRM DAP6;
02200 α AC INIT;
02300 MOVE ['1000002];SETZ 1,;BLT 6;
02400 HRLZI BIT,'400000;
02500 MOVE BTPTR,BI;
02600 MOVE TVPTR,TVBUF;
02700 MOVE RCNT,MROWS;
02800 α MAIN LOOPS;
02900 L1: MOVE WCNT,TVWW;
03000 L2: MOVEI BCNT,6;
03100 MOVE BYTE,(TVPTR);
03200 AOS TVPTR;
03300 L3: ROT BYTE,6;
03400 TRNE BYTE,'40; IOR 1,BIT; α BRIGHT;
03500 TRNE BYTE,'20; IOR 2,BIT;
03600 TRNE BYTE,8; IOR 3,BIT;
03700 TRNE BYTE,4; IOR 4,BIT;
03800 TRNE BYTE,2; IOR 5,BIT;
03900 TRNE BYTE,1; IOR 6,BIT; α DIM ;
04000 LSH BIT,-1;
04100 CAIN BIT, 8;
04200 JSR DACBUF;
04300 SOJG BCNT,L3; α BYTE COUNTER;
04400 SOJG WCNT,L2; α WORD COUNTER;
04500 α END OF A ROW;
04600 SKIPL BIT;
04700 JSR DACBUF;
04800 SOJG RCNT,L1; α ROW COUNTER;
04900 JRST L4;
00100 α DEPOSIT ACCUMULATORS INTO DD BUFFER AND RE-INIT 'EM;
00200 DACBUF: 0;
00300 MOVEM 1,(BTPTR);
00400 DAP2: MOVEM 2,(BTPTR);
00500 DAP3: MOVEM 3,(BTPTR);
00600 DAP4: MOVEM 4,(BTPTR);
00700 DAP5: MOVEM 5,(BTPTR);
00800 DAP6: MOVEM 6,(BTPTR);
00900 AOS BTPTR;
01000 SETZB 1,2; SETZB 3,4; SETZB 5,6;
01100 HRLZI BIT,'400000;
01200 JRST @DACBUF;
01300 L4:
01400 END "REPACK";
01500 ARRBLT(TVBUF[1],BI[1],11664);
01600 END "OUTER REPACK";
01700
01800 α ZERO MAG POWER EXPAND CASE;
01900 PROCEDURE EXPAN0 (INTEGER LL);
02000 BEGIN "EXPAN0"
02100 INTEGER TVPTR,WWID;
02200 TVPTR ← (SR + LL*216)*9 + SC%32;
02300 WWID ← (DN+31)%32;
02400 START_CODE
02500 LABEL L;
02600 MOVE 1,TVPTR;
02700 ADD 1,TVBUF;
02800 MOVE 2,BIBUF;
02900 MOVE 3,SM;
03000 L: HRLZ 7,1;
03100 HRR 7,2;
03200 ADD 2,WWID;
03300 BLT 7,-1(2);
03400 ADDI 1,9;
03500 SOJG 3,L;
03600 END;
03700 END "EXPAN0";
00100 α EXPAND A BIT IMAGE BY 2↑POWER, 1≤POWER≤7.
00200
00300 POWER FACTOR CONVERSION TABLE SIZE & NAME
00400 1 2 8 bits into halfwords 256 TABLE2
00500 2 4 8 bits into a word. 256 TABLE4
00600 3 8 4 bits into a word. 16 TABLE8
00700 4 16 2 bits into a word. 4 TABL16
00800 5 32 1 bit into a word. 2 TABLE1
00900 6 64 1 bit into 2 words. 2 TABLE1
01000 7 128 1 bit into 4 words. 2 TABLE1;
01100
01200
01300 PROCEDURE EXPAND (INTEGER LEVEL);
01400 BEGIN "EXPAND"
01500 SHORT INTEGER R,C,M,N,WWIN,WWOUT,POWER;
01600 INTEGER BYTCNT,COPIES,OLDPTR,WWDEL,WWSWN;
01700 α CHECK FOR ZERO EXPANSION CASE;
01800 IF MAGPOW=0 THEN BEGIN EXPAN0(ABS(LEVEL)-1);RETURN;END;
01900 α RESTRICT THE POWER RANGE;
02000 POWER ← MAGPOW;
02100 POWER ← (1 MAX POWER) MIN 7;
02200 α GET THE SOURCE WINDOW;
02300 R ← SR + 216*(ABS(LEVEL)-1);
02400 C ← SC;
02500 M ← SM;
02600 N ← SN;
02700 WWIN ← 9;
02800 α COMPUTE WORD WIDTHS OF THE WINDOW AND OUTPUT BUFFER;
02900 WWSWN ← ((C LAND '37)+SN+31)%32;
03000 WWOUT ← (DN + 31)%32;
03100 α INPUT BUFFER POINTER'S ROW DELTA;
03200 WWDEL ← WWIN - WWSWN;
03300 α THE NUMBER OF OUTPUT ROWS THAT ARE FORMED BY BLITING;
03400 COPIES ← (1 LSH POWER) - 1;
00100 α INNER LOOPS;
00200 START_CODE "INNER"
00300 α ACCUMULATORS;
00400 DEFINE BYTE="1", WORD="2", INPTR="3";
00500 DEFINE OUTPTR="4", RCNT="5", CCNT="6";
00600 DEFINE TMP="7", BRI="8", SIZ="9";
00700 DEFINE POW="10", MASK="11";
00800 α LABELS;
00900 LABEL NEWROW,BYTE1,BRINIT,NEWCOL,NEWBYT,GETBYT;
01000 LABEL TABPTR,RHALF,FULWRD,WRDCNT,EOR,EOR2;
01100 LABEL TABTAB,TABLE1,TABLE2,TABLE4,TABLE8,TABL16;
01200 LABEL BYTSIZ,CMASK,EOL,OP1,OP2;
01300 α IORM'S OR MOVEM'S;
01400 MOVE ['436004202004];
01500 SKIPL LEVEL;
01600 MOVSS;
01700 HLLZM OP1;
01800 HLLZM OP2;
01900 α INPUT POINTER;
02000 MOVE C;
02100 LSH -5;
02200 MOVE INPTR, R;
02300 IMUL INPTR, WWIN;
02400 ADD INPTR, ;
02500 ADD INPTR, TVBUF;
02600 α OUTPUT POINTER;
02700 MOVE OUTPTR, BIBUF;
02800 MOVEM OUTPTR, OLDPTR;
02900 α INIT POW AND SIZ ACCUMULATORS;
03000 MOVE POW, POWER;
03100 MOVE SIZ, BYTSIZ(POW);
03200 α FIND THE NUMBER OF THE FIRST BIT OF THE FIRST BYTE OF A ROW;
03300 MOVE C;
03400 AND CMASK(POW);
03500 HRRM BYTE1;
03600 α BITS REMAINING IN THE FIRST WORD;
03700 MOVNS;
03800 ADDI 32;
03900 HRRM BRINIT;
04000 α INIT THE EXPANSION TABLE POINTER;
04100 MOVE TABTAB(POW);
04200 HRRM TABPTR;
00100 α LOOP THRU ALL THE ROWS;
00200 MOVE RCNT, M;
00300 NEWROW: MOVE CCNT, N; α COLUMNS REMAINING IN THE ROW;
00400 α GET AND POSITION THE FIRST WORD OF THE ROW;
00500 MOVE WORD, (INPTR);
00600 AOS INPTR;
00700 BYTE1: ROT WORD, ;
00800 α LOOP THRU ALL THE COLUMNS - SIZ COLUMNS PER ITERATION;
00900 BRINIT: MOVEI BRI, ; α BITS REMAINING IN FIRST WORD;
01000 NEWCOL: JUMPLE CCNT, EOR; α END OF A ROW;
01100 α GET A WORD WHEN NECESSARY;
01200 JUMPN BRI, NEWBYT;
01300 MOVE WORD, (INPTR);
01400 AOS INPTR;
01500 MOVEI BRI, 32;
01600 CAMLE BRI, CCNT; α AVOID ROW OVERFLOW;
01700 MOVE BRI, CCNT;
01800 α GET A BYTE OF COLUMNS;
01900 NEWBYT: SETZ BYTE, ;
02000 CAMG SIZ, CCNT;
02100 JRST GETBYT;
02200 α RIGHT SIDE CLIPPING;
02300 ROTC BYTE, (CCNT);
02400 SETZ WORD,;
02500 MOVNS CCNT;
02600 ROTC BYTE, (CCNT);
02700 MOVNS CCNT;
02800 α UNPACK THE BYTE AND UPDATE THE COUNTERS;
02900 GETBYT: ROTC BYTE, (SIZ);
03000 SUB BRI, SIZ;
03100 SUB CCNT, SIZ;
00100 α EXPAND THE BYTE BY TABLE LOOKUP;
00200 TABPTR: MOVE (BYTE);
00300 α OUTPUT THE BYTE;
00400 SKIPE TMP, WRDCNT(POW);
00500 JRST FULWRD;
00600 α HALF WORD OF OUTPUT PER BYTE;
00700 LSH 2;
00800 TLCE OUTPTR, 1;
00900 JRST RHALF;
01000 HRLZ;
01100 OP1: IORM (OUTPTR); α LEFT SIDE;
01200 JRST NEWCOL;
01300 RHALF: LSH 2;
01400 IORI 2;
01500 IORM (OUTPTR); α RIGHT SIDE;
01600 AOS OUTPTR;
01700 JRST NEWCOL;
01800 α OUTPUT BY FULL WORDS;
01900 FULWRD: IORI 2;
02000 OP2: IORM (OUTPTR);
02100 AOS OUTPTR;
02200 SOJG TMP, FULWRD;
02300 JRST NEWCOL;
02400 α OUTPUT WORD COUNT TABLE;
02500 WRDCNT: 0;0;1;1;1;1;2;4;
00100 α AT THE END OF A ROW BLIT 2↑P-1 COPIES INTO THE OUTPUT BUFFER;
00200 EOR: MOVE TMP, COPIES;
00300 EOR2: HRLZ OLDPTR;
00400 HRR OUTPTR;
00500 HRRZM OUTPTR, OLDPTR;
00600 ADD OUTPTR, WWOUT;
00700 BLT -1(OUTPTR);
00800 SOJG TMP, EOR2;
00900 α SAVE THE POINTER;
01000 MOVEM OUTPTR, OLDPTR;
01100 TLZE OUTPTR, 1; α KNOCK OFF POSSIBLE HALFWORD BIT;
01200 AOS OUTPTR;
01300 α BUMP THE INPTR TO THE NEXT ROW;
01400 ADD INPTR, WWDEL;
01500 α DECREM THE ROW COUNT;
01600 SOJG RCNT, NEWROW;
01700 JRST EOL;
00100 α TABLE OF TABLE POINTER;
00200 TABTAB: 0;TABLE2;TABLE4;TABLE8;TABL16;TABLE1;TABLE1;TABLE1;
00300
00400 TABLE1: 0;'777777777760;
00500
00600 TABLE2:
00700 '000000; '000003; '000014; '000017; '000060; '000063; '000074; '000077;
00800 '000300; '000303; '000314; '000317; '000360; '000363; '000374; '000377;
00900 '001400; '001403; '001414; '001417; '001460; '001463; '001474; '001477;
01000 '001700; '001703; '001714; '001717; '001760; '001763; '001774; '001777;
01100 '006000; '006003; '006014; '006017; '006060; '006063; '006074; '006077;
01200 '006300; '006303; '006314; '006317; '006360; '006363; '006374; '006377;
01300 '007400; '007403; '007414; '007417; '007460; '007463; '007474; '007477;
01400 '007700; '007703; '007714; '007717; '007760; '007763; '007774; '007777;
01500
01600 '030000; '030003; '030014; '030017; '030060; '030063; '030074; '030077;
01700 '030300; '030303; '030314; '030317; '030360; '030363; '030374; '030377;
01800 '031400; '031403; '031414; '031417; '031460; '031463; '031474; '031477;
01900 '031700; '031703; '031714; '031717; '031760; '031763; '031774; '031777;
02000 '036000; '036003; '036014; '036017; '036060; '036063; '036074; '036077;
02100 '036300; '036303; '036314; '036317; '036360; '036363; '036374; '036377;
02200 '037400; '037403; '037414; '037417; '037460; '037463; '037474; '037477;
02300 '037700; '037703; '037714; '037717; '037760; '037763; '037774; '037777;
02400
02500 '140000; '140003; '140014; '140017; '140060; '140063; '140074; '140077;
02600 '140300; '140303; '140314; '140317; '140360; '140363; '140374; '140377;
02700 '141400; '141403; '141414; '141417; '141460; '141463; '141474; '141477;
02800 '141700; '141703; '141714; '141717; '141760; '141763; '141774; '141777;
02900 '146000; '146003; '146014; '146017; '146060; '146063; '146074; '146077;
03000 '146300; '146303; '146314; '146317; '146360; '146363; '146374; '146377;
03100 '147400; '147403; '147414; '147417; '147460; '147463; '147474; '147477;
03200 '147700; '147703; '147714; '147717; '147760; '147763; '147774; '147777;
03300
03400 '170000; '170003; '170014; '170017; '170060; '170063; '170074; '170077;
03500 '170300; '170303; '170314; '170317; '170360; '170363; '170374; '170377;
03600 '171400; '171403; '171414; '171417; '171460; '171463; '171474; '171477;
03700 '171700; '171703; '171714; '171717; '171760; '171763; '171774; '171777;
03800 '176000; '176003; '176014; '176017; '176060; '176063; '176074; '176077;
03900 '176300; '176303; '176314; '176317; '176360; '176363; '176374; '176377;
04000 '177400; '177403; '177414; '177417; '177460; '177463; '177474; '177477;
04100 '177700; '177703; '177714; '177717; '177760; '177763; '177774; '177777;
00100 TABLE4:
00200 '000000000000; '000000000360; '000000007400; '000000007760;
00300 '000000170000; '000000170360; '000000177400; '000000177760;
00400 '000003600000; '000003600360; '000003607400; '000003607760;
00500 '000003770000; '000003770360; '000003777400; '000003777760;
00600 '000074000000; '000074000360; '000074007400; '000074007760;
00700 '000074170000; '000074170360; '000074177400; '000074177760;
00800 '000077600000; '000077600360; '000077607400; '000077607760;
00900 '000077770000; '000077770360; '000077777400; '000077777760;
01000
01100 '001700000000; '001700000360; '001700007400; '001700007760;
01200 '001700170000; '001700170360; '001700177400; '001700177760;
01300 '001703600000; '001703600360; '001703607400; '001703607760;
01400 '001703770000; '001703770360; '001703777400; '001703777760;
01500 '001774000000; '001774000360; '001774007400; '001774007760;
01600 '001774170000; '001774170360; '001774177400; '001774177760;
01700 '001777600000; '001777600360; '001777607400; '001777607760;
01800 '001777770000; '001777770360; '001777777400; '001777777760;
01900
02000 '036000000000; '036000000360; '036000007400; '036000007760;
02100 '036000170000; '036000170360; '036000177400; '036000177760;
02200 '036003600000; '036003600360; '036003607400; '036003607760;
02300 '036003770000; '036003770360; '036003777400; '036003777760;
02400 '036074000000; '036074000360; '036074007400; '036074007760;
02500 '036074170000; '036074170360; '036074177400; '036074177760;
02600 '036077600000; '036077600360; '036077607400; '036077607760;
02700 '036077770000; '036077770360; '036077777400; '036077777760;
02800
02900 '037700000000; '037700000360; '037700007400; '037700007760;
03000 '037700170000; '037700170360; '037700177400; '037700177760;
03100 '037703600000; '037703600360; '037703607400; '037703607760;
03200 '037703770000; '037703770360; '037703777400; '037703777760;
03300 '037774000000; '037774000360; '037774007400; '037774007760;
03400 '037774170000; '037774170360; '037774177400; '037774177760;
03500 '037777600000; '037777600360; '037777607400; '037777607760;
03600 '037777770000; '037777770360; '037777777400; '037777777760;
00100 α TABLE 4 CONTINUED;
00200
00300 '740000000000; '740000000360; '740000007400; '740000007760;
00400 '740000170000; '740000170360; '740000177400; '740000177760;
00500 '740003600000; '740003600360; '740003607400; '740003607760;
00600 '740003770000; '740003770360; '740003777400; '740003777760;
00700 '740074000000; '740074000360; '740074007400; '740074007760;
00800 '740074170000; '740074170360; '740074177400; '740074177760;
00900 '740077600000; '740077600360; '740077607400; '740077607760;
01000 '740077770000; '740077770360; '740077777400; '740077777760;
01100
01200 '741700000000; '741700000360; '741700007400; '741700007760;
01300 '741700170000; '741700170360; '741700177400; '741700177760;
01400 '741703600000; '741703600360; '741703607400; '741703607760;
01500 '741703770000; '741703770360; '741703777400; '741703777760;
01600 '741774000000; '741774000360; '741774007400; '741774007760;
01700 '741774170000; '741774170360; '741774177400; '741774177760;
01800 '741777600000; '741777600360; '741777607400; '741777607760;
01900 '741777770000; '741777770360; '741777777400; '741777777760;
02000
02100 '776000000000; '776000000360; '776000007400; '776000007760;
02200 '776000170000; '776000170360; '776000177400; '776000177760;
02300 '776003600000; '776003600360; '776003607400; '776003607760;
02400 '776003770000; '776003770360; '776003777400; '776003777760;
02500 '776074000000; '776074000360; '776074007400; '776074007760;
02600 '776074170000; '776074170360; '776074177400; '776074177760;
02700 '776077600000; '776077600360; '776077607400; '776077607760;
02800 '776077770000; '776077770360; '776077777400; '776077777760;
02900
03000 '777700000000; '777700000360; '777700007400; '777700007760;
03100 '777700170000; '777700170360; '777700177400; '777700177760;
03200 '777703600000; '777703600360; '777703607400; '777703607760;
03300 '777703770000; '777703770360; '777703777400; '777703777760;
03400 '777774000000; '777774000360; '777774007400; '777774007760;
03500 '777774170000; '777774170360; '777774177400; '777774177760;
03600 '777777600000; '777777600360; '777777607400; '777777607760;
03700 '777777770000; '777777770360; '777777777400; '777777777760;
00100 TABLE8:
00200 '000000000000; '000000007760; '000003770000; '000003777760;
00300 '001774000000; '001774007760; '001777770000; '001777777760;
00400 '776000000000; '776000007760; '776003770000; '776003777760;
00500 '777774000000; '777774007760; '777777770000; '777777777760;
00600
00700 TABL16:
00800 '000000000000; '000003777760; '777774000000; '777777777760;
00900
01000 BYTSIZ: 0; 8; 8; 4; 2; 1; 1; 1;
01100 CMASK: 0;'30;'30;'34;'36;'37;'37;'37;
01200
01300 α END OF LOOP;
01400 EOL:
01500 END "INNER";
01600 END "EXPAND";
00100 α CONVERT SOURCE AND OBJECT XY WINDOWS INTO CLIPED RC WINDOWS;
00200 PROCEDURE WNCLIP ;
00300 BEGIN "WNCLIP"
00400 INTEGER RL,RH,CL,CH;
00500 INTEGER SXL,SXH,SYL,SYH;
00600 α MAGNIFICATION FROM MAG POWER;
00700 MAGNIF ← (1 LSH MAGPOW);
00800 α CONVERT OBJECT XY TO RC DESTINATION CENTRAL;
00900 DR ← (DDM%2-1) - OY;
01000 DC ← OX + DDN%2;
01100 α CLIP THE SOURCE WINDOW TO FIT THE DESTINATION FRAME;
01200 SXL←SX -(IF (DC-SDX*MAGNIF)<DDC THEN (DC-DDC )%MAGNIF ELSE SDX);
01300 SXH←SX +(IF (DC+SDX*MAGNIF)>DDC2 THEN (DDC2-DC)%MAGNIF ELSE SDX-1);
01400 SYH←SY +(IF (DR-SDY*MAGNIF)<DDR THEN (DR-DDR )%MAGNIF ELSE SDY-1);
01500 SYL←SY -(IF (DR+SDY*MAGNIF)>DDR2 THEN (DDR2-DR)%MAGNIF ELSE SDY);
01600 α CONVERT THE SOURCE WINDOW FROM XY TO RC;
01700 RL ← (TVM%2-1) - SYH;
01800 RH ← (TVM%2-1) - SYL;
01900 CL ← SXL + TVN%2;
02000 CH ← SXH + TVN%2;
02100 α CLIP THE RC SOURCE WINDOW TO FIT THE SOURCE FRAME;
02200 RL ← RL MAX 0;
02300 CL ← CL MAX 0;
02400 RH ← RH MIN (TVM-1);
02500 CH ← CH MIN (TVN-1);
02600 α INIT THE RC SOURCE WINDOW;
02700 SR ← RL;
02800 SC ← CL;
02900 SM ← RH - RL +1;
03000 SN ← CH - CL +1;
03100 α RE-INIT THE XY SOURCE WINDOW WHICH IS ALSO THE LOGICAL WINDOW;
03200 SDX ← SN/2;
03300 SDY ← SM/2;
03400 α PHYSICAL DESTINATION WINDOW;
03500 DC ← DDC MAX (DC-SDX*MAGNIF);
03600 DR ← DDR MAX (DR-SDY*MAGNIF);
03700 DR2 ← DDR2 MIN (DR + 2*SDY*MAGNIF-1);
03800 DC2 ← DDC2 MIN (DC + 2*SDX*MAGNIF-1);
03900 DM ← DR2 - DR + 1;
04000 DN ← DC2 - DC + 1;
04100 END "WNCLIP";
00100 PROCEDURE XVECTOR (INTEGER VWORD);
00200 BEGIN "XVECTORS"
00300 INTEGER DELROW,DELCOL,YFLAG,NCNT,BIPTR,BIT0,C0,R0;
00400 INTEGER RR,CC,R1,C1,R2,C2;
00500
00600 PROCEDURE XDOT;
00700 BEGIN "XDOT"
00800 SHORT INTEGER BIPTR,BIT0;
00900 RR ← RR - DR;
01000 CC ← CC - DC;
01100 BIPTR ← RR*BIWWID + CC%32;
01200 BIT0 ← 1 ROT - (1+(CC LAND '37));
01300 α PLACE THE DOT INTO THE BUFFER;
01400 START_CODE
01500 MOVE BIT0;
01600 MOVE 1,BIBUF;
01700 ADD 1,BIPTR;
01800 IORM (1);
01900 END;
02000 END "XDOT";
02100
02200 START_CODE "UNPACK"
02300 LABEL L;
02400 MOVE VWORD;
02500 HLRZ 1,;
02600 HRRZ 2,;
02700 CAME 1, 2;
02800 JRST L;
02900 α CALL DOT;
03000 LSH 1, -9;
03100 MOVEM 1, RR;
03200 ANDI 2, '777;
03300 MOVEM 2, CC;
03400 PUSHJ 15, XDOT;
03500 SUB 15, ['2000002];
03600 JRST @2(15);
03700 α CALL VECTOR;
03800 L: MOVE 1;
03900 LSH -9;
04000 MOVEM R1;
04100 ANDI 1, '777;
04200 MOVEM 1, C1;
04300 MOVE 2;
04400 LSH -9;
04500 MOVEM R2;
04600 ANDI 2, '777;
04700 MOVEM 2, C2;
04800 END "UNPACK";
04900
00100 α VECTOR EXECUTION CONTINUED;
00200 DELROW ← R2-R1;
00300 DELCOL ← C2-C1;
00400 IF DELCOL<0 THEN
00500 BEGIN
00600 C0 ← C2; R0 ← R2; DELCOL←ABS(DELCOL); DELROW←-DELROW;
00700 END ELSE
00800 BEGIN
00900 C0 ← C1; R0 ← R1;
01000 END;
01100 YFLAG ← DELROW;
01200 DELROW ← ABS(DELROW);
01300 NCNT ← DELROW MAX DELCOL;
01400 IF DELROW≥DELCOL THEN
01500 BEGIN
01600 NCNT ← DELROW;
01700 DELROW ← '400000;
01800 DELCOL ← '400000*DELCOL%NCNT;
01900 END ELSE
02000 BEGIN
02100 NCNT ← DELCOL;
02200 DELCOL ← '400000;
02300 DELROW ← '400000*DELROW%NCNT;
02400 END;
02500 R0 ← R0 - DR;
02600 C0 ← C0 - DC;
02700 BIPTR ← R0*BIWWID + C0%32;
02800 BIT0 ← 1 ROT -(1+(C0 LAND '37));
00100 α INNER LOOP OF VECTOR CREATION;
00200 START_CODE "TIGHT"
00300 LABEL L1,L2;
00400 INTEGER TMP16,TMP17;
00500 DEFINE BIT="0",CNT="1",CR="2",DEL="3",PTR="'15";
00600 α SAVE SAIL;
00700 MOVEM '16,TMP16;
00800 MOVEM '17,TMP17;
00900 α LOAD CACHE;
01000 HRLZI L1;
01100 HRRI 4;
01200 BLT '17;
01300 α INIT THE LOOP;
01400 MOVE BIT, BIT0;
01500 MOVE CNT, NCNT;
01600 SETZ CR,;
01700 HRRZ DEL, DELROW;
01800 HRL DEL, DELCOL;
01900 HRR '14, BIWWID;
02000 SKIPGE YFLAG;
02100 TLO '14, '4000;
02200 HRR PTR, BIBUF;
02300 ADD PTR, BIPTR;
02400 α ENTER THE LOOP;
02500 IORM BIT, (PTR);
02600 JRST 4;
02700 L1: ADD CR, DEL;
02800 JUMPGE CR, '13;
02900 TLCA CR, '400000;
03000 ROT BIT, -3;
03100 ROT BIT, -1;
03200 CAIN BIT, 8;
03300 AOJA PTR, 7;
03400 TRZE CR, '400000;
03500 ADDI PTR,;
03600 IORM BIT,;
03700 SOJG CNT, 4;
03800 JRST L2;
03900 L2: MOVE '16, TMP16;
04000 MOVE '17, TMP17;
04100 END "TIGHT";
04200 END "XVECTORS";
00100 INTEGER JBPTR;
00200 PROCEDURE XARC;
00300 BEGIN "XARC"
00400 REAL X,Y,S,C,XX;
00500 REAL KX,KY,KROW,KCOL;
00600 REAL BEAMX,BEAMY;
00700 INTEGER I,N,CNT; REAL L;
00800 PROCEDURE DOT (SHORT REAL X,Y);
00900 BEGIN "DOT"
01000 SHORT INTEGER RR,CC,BIPTR,BIT0;
01100 RR ← KROW - KY*Y;
01200 CC ← KCOL + KX*X;
01300 α AVOID OVERFLOW;
01400 DR2←DR+DM-1;
01500 DC2←DC+DN-1;
01600 IF RR = ((DR MAX RR) MIN DR2)
01700 ∧ CC = ((DC MAX CC) MIN DC2)
01800 THEN ELSE RETURN;
01900 RR ← RR - DR;
02000 CC ← CC - DC;
02100 BIPTR ← RR*BIWWID + CC%32;
02200 BIT0 ← 1 ROT - (1+(CC LAND '37));
02300 α PLACE THE DOT INTO THE BUFFER;
02400 START_CODE
02500 MOVE BIT0;
02600 MOVE 1,BIBUF;
02700 ADD 1,BIPTR;
02800 IORM (1);
02900 END;
03000 END "DOT";
03100 α COMPUTE SOURCE TO DESTINATION MAPPING CONSTANTS;
03200 KX ← (DN-1)/(2*LDX);
03300 KY ← (DM-1)/(2*LDY);
03400 KCOL ← DC - KX*(LX-LDX);
03500 KROW ← DR + KY*(LY+LDY);
03600 CNT ← ACNT;
00100 α PICKUP AN ARC FROM THE J BUFFER;
00200 FOR CNT←1 STEP 1 UNTIL ACNT DO
00300 BEGIN "ARC LOOP"
00400 START_CODE
00500 MOVN 1, CNT;
00600 IMULI 1, 6;
00700 ADD 1, JBPTR;
00800 SUBI 1, 1;
00900 MOVE 1001(1); MOVEM X;
01000 MOVE 1002(1); MOVEM Y;
01100 MOVE 1003(1); MOVEM L;
01200 MOVE 1004(1); MOVEM N;
01300 MOVE 1005(1); MOVEM BEAMX;
01400 MOVE 1006(1); MOVEM BEAMY;
01500 END;
01600 S ← SIN(L);
01700 C ← COS(L);
01800 FOR I←0 STEP 1 UNTIL N DO
01900 BEGIN
02000 DOT (X+BEAMX,Y+BEAMY);
02100 XX ← X*C - Y*S;
02200 Y ← Y*C + X*S;
02300 X ← XX;
02400 END;
02500 END "ARC LOOP";
02600 END "XARC";
00100 α DIRECTORY OF TV PICTURES ON THE DRUM;
00200 SAFE INTEGER ARRAY TVNAME [1:100];
00300 SAFE INTEGER ARRAY FBPTRS [1:100];
00400 SAFE INTEGER ARRAY FBFILE [1:100];
00500 SAFE INTEGER ARRAY DDFRAME[1:150];
00600 INTEGER TVLAST;
00700 INTEGER TVNOW;
00800
00900 PROCEDURE XDSKTV;
01000 BEGIN "XDSKTV"
01100 INTEGER CHR,FBPTR,I;
01200 STRING STR,FILE;
01300 IF FILENAME=TVNOW THEN RETURN;
01400 FOR I←1 STEP 1 UNTIL TVLAST DO
01500 IF FILENAME=TVNAME[I] THEN
01600 BEGIN
01700 FBPTR ← FBPTRS[I];
01800 START_CODE MOVE 11,TVBUF;HRRZM 11,TVPTR;END;
01900 DRUMI(TVPTR,FBPTR);
02000 TVNOW ← FILENAME;
02100 RETURN;
02200 END;
02300 α GET FROM THE 2314 DISK;
02400 BREAKSET(1," ","I");
02500 STR ← CVXSTR(FILENAME);
02600 FILE ← SCAN(STR,1,CHR);
02700 DSKTV(FILE);
02800 I←TVLAST←TVLAST + 1;
02900 START_CODE MOVE 11,TVBUF;HRRZM 11,TVPTR;END;
03000 FBPTR ← DRUMA(10368);
03100 DRUMO(TVPTR,FBPTR);
03200 FBFILE[I]← FBPTR;
03300 REPACK;
03400 TVNOW ← FILENAME;
03500 α SAVE ON THE DRUM;
03600 FBPTR ← DRUMA(11664);
03700 DRUMO(TVPTR,FBPTR);
03800 FBPTRS[I]← FBPTR;
03900 TVNAME[I]← FILENAME;
04000 END "XDSKTV";
00100 α COMMAND #3 - EXECUTE DRUM DD OF A FRAME NUMBER;
00200 PROCEDURE XDRUMDD;
00300 BEGIN "XDRUMDD"
00400 INTEGER F,I,FBPTR,ADR;
00500 F←FRAME#;
00600 IF ABS(F)>150 THEN RETURN;
00700 α FLUSH THE LIBRASCOPE;
00800 IF F=0 THEN
00900 BEGIN
01000 FOR I←1 STEP 1 UNTIL 50 DO
01100 IF DDFRAME[I] THEN DRUMR(DDFRAME[I]);
01200 DDFRAME[1]←0;ARRBLT(DDFRAME[2],DDFRAME[1],49);
01300 RETURN;
01400 END;
01500 α OUTPUT TO THE LIBRASCOPE;
01600 IF F<0 THEN
01700 BEGIN
01800 FRAME#←F-1;
01900 F←ABS(F);
02000 IF DDFRAME[F] THEN DRUMR(DDFRAME[F]);
02100 FBPTR ← DRUMA(DDSIZE);
02200 START_CODE MOVE DDBUF;HRRZM ADR;END;
02300 DRUMO(ADR,FBPTR);
02400 DDFRAME[F]← FBPTR;
02500 END ELSE
02600 IF DDFRAME[F]≠0 THEN
02700 BEGIN "DRUMDD IN"
02800 FRAME#←F+1;
02900 FBPTR ← DDFRAME[F];
03000 DDSIZE ← FBPTR LAND '777777;
03100 GETARY(DDBUF,DDSIZE);
03200 START_CODE MOVE DDBUF;HRRZM ADR;END;
03300 DRUMI(ADR,FBPTR);
03400 SHOWDD;
03500 RELARY(DDBUF);
03600 END "DRUMDD IN";
03700 END "XDRUMDD";
00100 α COMMAND #1 - EXECUTE DPYDD;
00200
00300 PROCEDURE XDPYDD;
00400 BEGIN "XDPYDD"
00500 INTEGER M,I;
00600 INTEGER ARRAY CHAN[1:6];
00700 XDSKTV;
00800 QUICK_CODE '701000000000 1,HISJOB END;
00900 WNCLIP;
01000 BIWWID← (DN + 31)%32;
01100 BISIZE← DM * BIWWID;
01200 GETARY(BIBUF,BISIZE);
01300 FOR I←1 STEP 1 UNTIL 6 DO
01400 CHAN[I]←(LEVWRD←(LEVWRD ROT 6))LAND 7;
01500 FOR I←1 STEP 1 UNTIL 6 DO
01600 IF CHAN[I]≠0 THEN
01700 BEGIN
01800 GETDD;
01900 EXPAND(I);
02000 SETCHN(CHAN[I]);
02100 PLOWIN;
02200 IF FRAME# THEN XDRUMDD;
02300 SHOWDD;
02400 RELARY(DDBUF);
02500 END;
02600 RELARY(BIBUF);
02700 END "XDPYDD";
00100 PROCEDURE XSHOWDD;
00200 BEGIN "XSHOWDD"
00300 INTEGER I,JSIZE,LEVEL,CHANEL;
00400 LEVEL ← (ABS(LEVCHN)ROT -3)LAND 7;
00500 IF LEVEL=7 THEN LEVEL←0;
00600 CHANEL ← (ABS(LEVCHN)LAND 7);
00700 IF CHANEL=7 THEN CHANEL←0;
00800 IF LEVEL THEN XDSKTV;
00900 JSIZE← IF ACNT THEN 1000 ELSE VCNT+2;
01000 BEGIN
01100 INTEGER ARRAY JOBBUF[1:JSIZE];
01200 START_CODE "GET J BUF"
01300 LABEL Q,L;
01400 INTEGER ARG1,ARG2,ARG3;
01500 MOVE HISJOB;
01600 MOVEM ARG1;
01700 MOVE JADDR;
01800 MOVEM ARG2;
01900 MOVN JSIZE;
02000 HRLM ARG2;
02100 MOVE JOBBUF;
02200 MOVEM ARG3;
02300 MOVEM JBPTR;
02400 MOVEI ARG1;
02500 '40000000000 Q;
02600 JFCL;
02700 JRST L;
02800 Q: '525742624400;
02900 L:
03000 END "GET J BUF";
03100 BIWWID← (DN + 31)%32;
03200 BISIZE← DM * BIWWID;
03300 GETARY(BIBUF,BISIZE);
03400 IF LEVEL THEN EXPAND(LEVEL);
03500 α GENERATE GRAPHICS FROM THE CONTENTS OF THE JOB READ BUFFER;
03600 FOR I←1 STEP 1 UNTIL VCNT DO XVECTOR (JOBBUF[I]);
03700 IF ACNT≠0 THEN XARC;
03800 α CREATE DD BUFFER FROM BI BUFFER;
03900 GETDD;
04000 PLOWIN;
04100 SETCHN(CHANEL);
04200 IF LEVCHN<0 THEN DPB(1,POINT(1,DDBUF[1],3));
04300 QUICK_CODE '701000000000 1,HISJOB END;
04400 SHOWDD;
04500 IF FRAME# THEN XDRUMDD;
04600 RELARY(DDBUF);
04700 RELARY(BIBUF);
04800 END;
04900 END "XSHOWDD";
00100 α COMMAND #4 - EXECUTE TV UPPER SEGMENT CREATION;
00200 PROCEDURE XTVSEG;
00300 BEGIN "XTVSEG"
00400 INTEGER FBPTR,I,FLG,UPNAME;
00500 α UPPER SEGMENT DEFINITIONS;
00600 DEFINE CALLI = "'047000000000";
00700 DEFINE CORE2 = "'400015";
00800 DEFINE ATTSEG = "'400016";
00900 DEFINE DETSEG = "'400017";
01000 DEFINE SEGSIZ = "'400022";
01100 DEFINE SETNM2 = "'400036";
01200 DEFINE NAMEIN = "'400043";
01300 DEFINE SAISG2 = "'634151634722";
01400 α KILL UPPER SEGMENT AND RETURN;
01500 UPNAME ← SEGNAME;
01600 IF FILENAME=0 THEN
01700 START_CODE "KILLUP"
01800 SETZ 1,;
01900 CALLI DETSEG;
02000 MOVE UPNAME;
02100 CALLI ATTSEG; JFCL;
02200 CALLI 1, CORE2; JFCL;
02300 MOVE [SAISG2];
02400 CALLI ATTSEG; JFCL;
02500 POPJ 15,
02600 END "KILLUP";
02700 XDSKTV;
02800 FOR I←1 STEP 1 UNTIL TVLAST DO
02900 IF FILENAME=TVNAME[I] THEN
03000 BEGIN
03100 FBPTR ← FBFILE[I];
03200 QUICK_CODE MOVE 11,TVBUF;HRRZM 11,TVPTR;END;
03300 DRUMI(TVPTR,FBPTR);
03400 TVNOW ← 0;
03500 BEGIN "FILEUP"
00100 START_CODE
00200 MOVE 1, [10400];
00300 CALLI DETSEG;
00400 MOVE UPNAME;
00500 CALLI ATTSEG;
00600 SKIPA;
00700 SKIPA;
00800 CALLI 1, CORE2;
00900 JFCL;
01000 HRLZ TVBUF;
01100 HRRI '400001;
01200 BLT '424201;
01300 MOVE UPNAME;
01400 CALLI SETNM2;
01500 JFCL;
01600 CALLI 1, DETSEG;
01700 MOVE [SAISG2];
01800 CALLI ATTSEG;
01900 JFCL;
02000 END;
02100 END "FILEUP";
02200 END;
02300 END "XTVSEG";
00100 α MAIN DDJOB EXECUTION;
00200 WHILE TRUE DO
00300 BEGIN "FOREVER"
00400 CASE COMMAND OF
00500 BEGIN
00600 IF HISJOB THEN ELSE OUTCHR("*");
00700 XDPYDD;
00800 XSHOWDD;
00900 XDRUMDD;
01000 XTVSEG;
01100 END;
01200 α RETURN RESULTS LETTER TO THE CALLER;
01300 START_CODE "RETURN"
01400 INTEGER CALLER,LTRPTR;
01500 LABEL L;
01600 SKIPN 1, HISJOB;
01700 JRST L;
01800 MOVEM 1, CALLER;
01900 MOVE LETTER;
02000 MOVEM LTRPTR;
02100 MAIL CALLER;
02200 JFCL;
02300 L:
02400 END "RETURN";
02500 α WAIT FOR A COMAND LETTER;
02600 START_CODE "WAITING"
02700 LABEL L;
02800 MOVE 1,LETTER;
02900 HRRM 1,L;
03000 L: MAIL 1,;
03100 MOVE 16(1); MOVEM LX;
03200 MOVE 17(1); MOVEM LY;
03300 MOVE 18(1); MOVEM LDX;
03400 MOVE 19(1); MOVEM LDY;
03500 END "WAITING";
03600 END "FOREVER";
03700 END;
03800 END "DDJOB";